 REM > <calendar$Dir>.!RunImage
 REM (C) Rob Craig-Wood

 SYS "Wimp_Initialise",200,&4B534154,"Calendar" TO ,task%
 ON ERROR PROCclose:REPORT:PRINT" at line ";ERL:END
 OSCLI("Set Calendar$Loaded Yes")
 PROCinit
 ON ERROR IF FNerror THEN PROCclose:END
 REPEAT
 PROCpoll
 UNTIL quit%
 PROCclose
 END
:
 DEF PROCclose
 REM shuts down application
 OSCLI("Set calendar$Loaded No")
 SYS "Wimp_CloseDown",task%,&4B534154
 ENDPROC
:
 DEF PROCpoll
 REM main Wimp polling routine
 SYS "Wimp_Poll",,b% TO r%
 CASE r% OF
 WHEN 1 : PROCredraw
 WHEN 2 : SYS "Wimp_OpenWindow",,b%
 WHEN 3 : SYS "Wimp_CloseWindow",,b% : PROCclose
 WHEN 6 : PROCmouseclick
 WHEN 17,18 : PROCreceive
 ENDCASE
 ENDPROC
:
 DEF FNerror
 REM main error handling routine
 !b%=ERR
 CASE !b% OF
 WHEN 1<<30:err_str$="":box%=3
 WHEN (1<<30)+1:err_str$="":box%=1
 WHEN (1<<30)+2:err_str$="":box%=2
 OTHERWISE:err_str$=" at line "+STR$ ERL:box%=2
 ENDCASE
 $(b%+4)=REPORT$+err_str$+CHR$0
 SYS "Wimp_ReportError",b%,box%,"Calendar" TO ,response%
 =(response%=2)
:
 DEF PROCreceive
 REM handles Wimp messages
 CASE b%!16 OF
 WHEN 0:quit%=TRUE
 ENDCASE
 ENDPROC
:
 DEF PROCinit
 REM main initialisation routine
 DIM b% 3000,ws% 3000
 wsend%=ws%+3000
 quit%=FALSE
 olcalday%=1
 PROCload_templates
 PROCtime_vars

 calmonth%=FNclock_find_month
 calyear%=VAL(MID$(TIME$,12,4))
 calday%=FNclock_find_day
 FOR n=VAL(MID$(TIME$,5,2)) TO 2 STEP -1
  PROCcalday_change(-1)
 NEXT n
 PROCupdate_calendar
 b%!0=calendar%
 SYS "Wimp_GetWindowState",,b%
 SYS "Wimp_OpenWindow",,b%
 ENDPROC
:
 DEF PROCtime_vars
 DIM days$(7)
 RESTORE +1
 DATA Sun,Mon,Tue,Wed,Thu,Fri,Sat
 FOR n=1 TO 7
  READ days$(n)
 NEXT n

 DIM monthb$(12)
 RESTORE +1
 DATA January,February,March,April,May,June,July,Aug,September,October,November,December
 FOR n=1 TO 12
  READ monthb$(n)
 NEXT n

 DIM monthd(12)
 RESTORE +1
 DATA 31,28,31,30,31,30,31,31,30,31,30,31
 FOR n=1 TO 12
  READ monthd(n)
 NEXT n

 DIM leapyrs(10)
 RESTORE+1
 DATA 1992,1996,2004,2008,2012,2016,2020,2024,2028,2032
 FOR n=1 TO 10
  READ leapyrs(n)
 NEXT n
 ENDPROC
:
 DEF PROCmouseclick
 REM called when mouse button pressed or clicked
 REM b%!0=mousex,b%!4=mousey:b%!8=buttons:b%!12=window handle (-2 for icon bar):b%!16=icon han dle
 CASE b%!16 OF
  WHEN 4 : PROCcalmonth_change(-1) : PROCupdate_calendar
  WHEN 5 : PROCcalmonth_change(1) : PROCupdate_calendar
  WHEN 7 : PROCcalyear_change(-1) : PROCupdate_calendar
  WHEN 8 : PROCcalyear_change(1) : PROCupdate_calendar
 ENDCASE
 ENDPROC
:
 DEF PROCload_templates
 SYS "Wimp_OpenTemplate",,"<calendar$Dir>.Templates"
 SYS "Wimp_LoadTemplate",,b%,ws%,wsend%,-1,"calendar",0 TO ,,ws%
 SYS "Wimp_CreateWindow",,b% TO calendar%
 SYS "Wimp_CloseTemplate"
 ENDPROC
:
 DEF PROCredraw
 REM redraws window contents
 SYS "Wimp_RedrawWindow",,b% TO more%
 WHILE more%
 REM PROCdraw(!b%)
 SYS "Wimp_GetRectangle",,b% TO more%
 ENDWHILE
 ENDPROC
:
 DEF PROCset_icon_colour(window%,icon%,col%)
 b%!0=window%
 b%!4=icon%
 b%!8=col%<<24
 b%!12=%1111<<24
 SYS "Wimp_SetIconState",,b%
 ENDPROC
:
 DEF PROCforce_redraw(window%)
 REM redraws visible portion of window
 LOCAL c%
 c%=b%+500
 !c%=window%
 SYS "Wimp_GetWindowState",,c%
 SYS "Wimp_ForceRedraw",-1,c%!4,c%!8,c%!12,c%!16
 ENDPROC
:
 DEF FNstring_addr(window%,icon%)
 REM returns address of icon's indirected text string
 LOCAL c%
 c%=b%+500
 !c%=window%
 c%!4=icon%
 SYS "Wimp_GetIconState",,c%
 =c%!28
:
 DEF PROCset_icon_string(window%,icon%,a$)
 REM sets icon's indirected text string
 $FNstring_addr(window%,icon%)=a$
 ENDPROC
:
 DEF FNclock_find_day
 FOR n=1 TO 7
  IF MID$(TIME$,1,3)=days$(n) THEN fday%=n
 NEXT n
 =fday%
:
 DEF FNclock_find_month
 FOR n=1 TO 12
  IF MID$(monthb$(n),1,3)=MID$(TIME$,8,3) fmonth%=n
 NEXT n
 =fmonth%
:
 DEF FNclock_check_leapyr(lyr%)
 leap%=FALSE
 FOR n=1 TO 10
  IF lyr%=leapyrs(n) THEN leap%=TRUE
 NEXT n
 =leap%
:
 DEF PROCupdate_calendar
 PROCset_icon_colour(calendar%,(VAL(MID$(TIME$,5,2))+16+olcalday%),7)
 PROCset_icon_string(calendar%,3,monthb$(calmonth%))
 PROCset_icon_string(calendar%,6,STR$(calyear%))
 FOR n=18 TO 54
  PROCset_icon_string(calendar%,n,"")
 NEXT n
 FOR n=1 TO monthd(calmonth%)
  PROCset_icon_string(calendar%,(16+calday%+n),STR$(n))
 NEXT n
 IF calmonth%=2 THEN
  IF FNclock_check_leapyr(calyear%)=TRUE PROCset_icon_string(calendar%,(45+calday%),"29")
 ENDIF
 IF calmonth%=FNclock_find_month AND calyear%=VAL(MID$(TIME$,12,4)) THEN
  PROCset_icon_colour(calendar%,(VAL(MID$(TIME$,5,2))+16+calday%),11)
  olcalday%=calday%
 ENDIF
 PROCforce_redraw(calendar%)
 ENDPROC
:
 DEF PROCcalday_change(nd)
 calday%=calday%+nd
 IF calday%<1 calday%=7
 IF calday%>7 calday%=1
 ENDPROC
:
 DEF PROCcalmonth_change(nm)
 oldcalmonth%=calmonth%
 calmonth%=calmonth%+nm
 IF calmonth%<1 calyear%=calyear%-1 : calmonth%=12
 IF calmonth%>12 calyear%=calyear%+1 : calmonth%=1
 IF nm=-1 THEN oldcalmonth%=calmonth%
 FOR x=1 TO monthd(oldcalmonth%)
  PROCcalday_change(nm)
 NEXT x
 IF oldcalmonth%=2 THEN
  IF FNclock_check_leapyr(calyear%)=TRUE PROCcalday_change(nm)
 ENDIF
 ENDPROC
:
 DEF PROCcalyear_change(ny)
 oldcalyear%=calyear%
 calyear%=calyear%+ny
 FOR n=1 TO 365
  PROCcalday_change(ny)
 NEXT n
 IF ny=1 THEN
  IF calmonth%>2 THEN
   IF FNclock_check_leapyr(calyear%)=TRUE PROCcalday_change(1)
  ENDIF
  IF calmonth%<2 THEN
   IF FNclock_check_leapyr(oldcalyear%)=TRUE PROCcalday_change(1)
  ENDIF
 ELSE
  IF calmonth%>2 THEN
   IF FNclock_check_leapyr(oldcalyear%)=TRUE PROCcalday_change(-1)
  ENDIF
  IF calmonth%<2 THEN
   IF FNclock_check_leapyr(calyear%)=TRUE PROCcalday_change(-1)
  ENDIF
 ENDIF
 ENDPROC
:


